home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 21.zip / BS1 part 21 / Professional Page v4.0 (1993)(Gold Disk)(Disk 1 of 4)[HD].7z / Professional Page v4.0 (1993)(Gold Disk)(Disk 1 of 4)[HD].adf / rexx.lzh / ADProHotLink.pprx < prev    next >
Text File  |  1992-03-13  |  2KB  |  92 lines
  1. /*
  2. @BADProHotLink  @P@ICopyright Gold Disk Inc., February, 1992
  3. This Genie sends a bitmap to Art Department Professional and reimports the bitmap when Art Department Professional quits.
  4. */
  5. call setclip(ppuser_adclip, "")
  6. cr = '0a'x
  7. call SafeEndEdit.rexx()
  8. options results
  9.  
  10. box = ppm_ClickOnBox("Select box with a bitmap")
  11. if box = 0 then exit_msg()
  12.  
  13. info  = ppm_GetBoxInfo(box)
  14. if upper(word(info,1)) ~= "BITMAP" then exit_msg("Box must have a bitmap in it")
  15.  
  16. fname = subword(info, 5)
  17.  
  18.  
  19. screenmodes = "8   H_OVERSCAN"cr"4   PAL"cr"1   HIRES"cr"2   INTERLACE"cr"16  V_OVERSCAN"
  20. rendermodes = "2"cr"4"cr"8"cr"16"cr"32"cr"64"cr"128"cr"256"cr"AHAM"cr"ARZ0"cr"ARZ1"cr"CUST"cr"EHB"cr"HAM"
  21.  
  22. screenmode  = ppm_SelectFromList("Select Screen Mode..", 25, 5, 1, screenmodes)
  23. if screenmode = '' then exit_msg()
  24.  
  25. mode = 0
  26.  
  27. do while screenmode ~= ''
  28.  
  29.    parse var screenmode temp '0a'x screenmode
  30.  
  31.    mode = mode + word(temp , 1)
  32.  
  33. end
  34.  
  35. mode = substr(mode, 2)
  36.  
  37. rendermode  = ppm_SelectFromList("Select Render Mode..", 25, 5, 0, rendermodes)
  38. if rendermode = '' then exit_msg()
  39.  
  40. dimension   = "Width:"word(info, 2) || cr"Height:"word(info, 3)
  41. dimension   = ppm_GetForm("Enter image dimensions", 8, dimension)
  42. if dimension = '' then exit_msg()
  43.  
  44. parse var dimension iwidth '0a'x iheight
  45.  
  46. if ~(datatype(iwidth, n) & datatype(iheight, n)) then exit_msg("Invalid Entry")
  47. address command
  48. adargs = iwidth';'iheight';'rendermode';'fname';'mode
  49. call setclip(ppuser_adargs, adargs)
  50.  
  51. adpro = 'ADPro:ADPro'
  52.  
  53. if ~exists(adpro) then
  54. do
  55.   adpro = ppm_GetFileName("Please locate ADPro..", "",)
  56.   if adpro = '' then exit_msg()
  57. end
  58.  
  59. "run >nil:" "rx rexx:ADProComm.rexx "
  60.  
  61. if  ~show(p, 'ADPro') then
  62. do
  63.  
  64.      /* this genie will go to sleep until adpro has quit   */
  65.     address command
  66.     adpro ">nil:"
  67.  
  68.     adclip = getclip(ppuser_adclip)
  69.     if adclip ~= "1" then exit_msg("Unable to start ADPro")
  70.  
  71. end
  72. else
  73. do
  74.     call ppm_Inform(1, "ADPro has already started. Click here when finished processing bitmap.",)
  75. end
  76.  
  77. call ppm_PPageToFront()
  78. call ppm_ShowStatus("Reimporting BitMap..")
  79. call ppm_DeleteContents(box)
  80. call ppm_ImportBM(box, fname)
  81.  
  82. exit_msg()
  83.  
  84. exit_msg: procedure
  85. do
  86.    parse arg message
  87.  
  88.    if message ~= '' then call ppm_Inform(1, message,)
  89.    call ppm_ClearStatus()
  90.    exit
  91. end
  92.